home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr48
/
oscil.zip
/
OSCIL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-04-01
|
8KB
|
265 lines
program OSCILLISCOPE; { Reads VOC files and displays OSCILLISCOPE
By Corey Roome
9:19 pm
1/29/92 }
uses
Crt, Graph;
var
Gd, Gm : Integer; { Graphics mode and driver }
KEY, STFIL : char; { What Key and the character }
FNM : Text; { File Name }
OX, OY : Integer; { Old X and Y positions }
XLOC, COUNT : Integer; { Location of X and COUNTING }
BUF : Integer; { Buffer to fill }
NODES : Integer; { How many nodes at once }
JMP : Integer; { How far to jump }
PAUSE : Integer; { Timing Delay }
Y3DLOC, X3DLOC : Integer; { Where 3D X and Y are NOW }
DIRECT : Integer; { Which way is 3D X traveling }
OX3D, OY3D : Integer; { Old 3D X's and Y's }
BTM, TOP : Integer; { Bottom and Top on or off }
NAME : String; { Name of File }
XJMP, MODE : Integer; { Mode of the X movement }
RANDXMAX,RANDXMIN : Integer; { Max random X,Y freq }
COLOR : Integer; { Color number }
S : String; { Little S helper for conversions }
TESPD : Integer; { Temporary speed for pause memory }
procedure INIT; { Initilize Variables and Screen }
begin
TESPD := 0;
COLOR := 10;
XJMP := 0;
MODE := 2; { 1 is matched, 2 is random }
RANDXMAX := 255;
RANDXMIN := 0;
BTM := 1;
TOP := 1;
DIRECT := 1;
Y3DLOC := 90;
X3DLOC := 300;
OX3D := X3DLOC;
OY3D := Y3DLOC;
PAUSE := 0;
NODES := 49;
JMP := 545 div NODES;
Gd := 9;
Gm := 2;
BUF := 0;
COUNT := 0;
XLOC := 1;
OX := XLOC;
OY := 325;
ClrScr;
Writeln ('Oscilliscope for Sound Blaster VOC files');
Writeln;
Writeln ('By Corey Roome');
Writeln;
Writeln;
Writeln ('Keys not included on bottom of screen: ');
Writeln;
Writeln ('C: Change color of oscilliscope');
Writeln ('M: Change mode (simulated stereo, or mono)');
Writeln;
Writeln;
Write ('Enter a FILENAME, including extension (ie COREY.VOC) >');
Readln (NAME);
Assign (FNM,NAME);
InitGraph (Gd, Gm,'C:\TP\BGI');
SetColor (LightGray);
SetFillStyle (1,LightGray);
FloodFill (0,0,11);
SetColor (DarkGray);
SetFillStyle (1,Darkgray);
Bar (30,205,600,455);
Bar (30,10,310,195);
Bar (320,10,600,195);
SetFillStyle (1,Black);
Bar (325,5,605,190);
Bar (35,5,315,190);
Bar (35,200,605,450);
SetTextStyle (2,HorizDir,4);
SetColor (EGARed);
OutTextXY (30,460,'1 --> 0 : SPEED + : INCREASE NODES - : DECREASE NODES T : Top B : Bottom P : PAUSE Q : QUIT');
SetTextStyle (1,HorizDir,1);
SetColor (EGAYellow);
OutTextXY (400,10,'Status Screen');
SetTextStyle (2,HorizDir,5);
SetColor (EGAWhite);
Str(500-PAUSE,S);
OutTextXY (330,45,'Speed :');
OutTextXY (390,45,S);
OutTextXY (330,65,'Mode :');
if MODE = 2 then OutTextXY (390,65,'Stereo') else OutTextXY (390,65,'Mono');
OutTextXY (330,85,'Nodes :');
Str(NODES,S);
OutTextXY (390,85,S);
OutTextXY (330,105,'Top :');
if TOP = 1 then OutTextXY (390,105,'On') else OutTextXY (390,105,'Off');
OutTextXY (330,125,'Bottom :');
if BTM = 1 then OutTextXY (390,125,'On') else OutTextXY (390,125,'Off');
SetColor (COLOR);
end;
procedure Update; { Update Status Bar }
begin
SetColor (EGAWhite);
Bar (390,45,480,170);
Str(500-PAUSE,S);
OutTextXY (390,45,S);
if MODE = 2 then OutTextXY (390,65,'Stereo') else OutTextXY (390,65,'Mono');
Str(NODES,S);
OutTextXY (390,85,S);
if TOP = 1 then OutTextXY (390,105,'On') else OutTextXY (390,105,'Off');
if BTM = 1 then OutTextXY (390,125,'On') else OutTextXY (390,125,'Off');
SetColor (COLOR);
end;
procedure WhatKey; { When key is pressed, go here }
begin
KEY := ReadKey;
Case upCase(Key) of
'-' : NODES := NODES - 1;
'+' : NODES := NODES + 1;
'1' : PAUSE := 0;
'2' : PAUSE := 50;
'3' : PAUSE := 100;
'4' : PAUSE := 150;
'5' : PAUSE := 200;
'6' : PAUSE := 250;
'7' : PAUSE := 300;
'8' : PAUSE := 350;
'9' : PAUSE := 400;
'0' : PAUSE := 450;
'B' : begin
if BTM = 1 then BTM := 0 else BTM := 1;
if BTM = 0 then BAR (35,200,605,450);
end;
'T' : begin
if TOP = 1 then TOP := 0 else TOP := 1;
if TOP = 0 then BAR (35,5,315,190);
end;
'M' : begin
if MODE = 1 then MODE := 2 else MODE := 1;
end;
'C' : begin
INC(COLOR);
if COLOR > 15 then COLOR := 1;
end;
end;
if NODES < 22 then NODES := 22;
if NODES > 70 then NODES := 70;
JMP := 545 div NODES;
update;
end;
procedure Display3D; { Display 3D Oscilliscope }
begin
if MODE = 1 then begin
IF ORD(STFIL)> 128 then X3DLOC := X3DLOC + (ORD(STFIL)-129);
IF ORD(STFIL)< 129 then X3DLOC := X3DLOC + (ORD(STFIL)-129);
end;
if MODE = 2 then begin
IF XJMP> 128 then X3DLOC := X3DLOC + (XJMP-129);
IF XJMP< 129 THEN X3DLOC := X3DLOC + (XJMP-129);
end;
PutPixel (X3DLOC-145,(ORD(STFIL)+80) div 2,COLOR);
X3DLOC := 320;
end;
procedure Reorder; { Reorder output for PAUSE }
begin
OX := XLOC;
OY := ORD(STFIL)+200;
if TOP = 1 then Display3D;
if BUF > NODES then begin
if upCase (KEY) = 'P' then begin
TESPD := PAUSE;
PAUSE := 500;
update;
repeat
until KeyPressed;
KEY := ' ';
PAUSE := TESPD;
end;
Delay (PAUSE);
SetFillStyle (SolidFill,0);
Bar (35,5,315,190);
BUF := 0;
XLOC := 0;
OX := 0;
OY := 325;
end;
end;
procedure Displayit; { Main DISPLAY }
begin
SetColor (COLOR);
INC(BUF);
XLOC := XLOC + JMP;
if BTM = 0 then reorder;
if BTM = 0 then exit;
PutPixel (XLOC+40,ORD(STFIL)+200,COLOR);
Line (OX+40,OY,XLOC+40,ORD(STFIL)+200);
OX := XLOC;
OY := ORD(STFIL)+200;
if TOP = 1 then Display3D;
if BUF > NODES then begin
if upCase (KEY) = 'P' then begin
TESPD := PAUSE;
PAUSE := 500;
update;
repeat
until KeyPressed;
KEY := ' ';
PAUSE := TESPD;
end;
Delay (PAUSE);
SetFillStyle (SolidFill,0);
Bar (35,200,605,450);
if TOP = 1 then Bar (35,5,315,190);
BUF := 0;
XLOC := 0;
OX := 0;
OY := 325;
end;
end;
procedure Entfile; { Enter file into variable }
begin
Reset (FNM);
SetColor (COLOR);
Repeat
Repeat
inc(COUNT);
Read (FNM,STFIL);
if (MODE = 2) and (TOP = 1) then begin
if DIRECT = -1 then XJMP:=XJMP-3;
if DIRECT = 1 then XJMP:=XJMP+3;
if (XJMP<RANDXMIN) or (XJMP>RANDXMAX) then begin
if DIRECT = 1 THEN DIRECT := -1 ELSE DIRECT := 1;
RANDXMAX:=Random(255);
RANDXMIN:=Random(255);
if RANDXMAX < 190 then RANDXMAX := 190;
if RANDXMIN > 100 then RANDXMIN := 100;
{ if (ORD(STFIL) > 137) and (RANDXMAX > ORD(STFIL)+10) then RANDXMAX := ORD(STFIL)+10;
if (ORD(STFIL) < 137) and (RANDXMIN < ORD(STFIL)-10) then RANDXMIN := ORD(STFIL)-10;}
if DIRECT = 1 then XJMP := XJMP +3 else XJMP := XJMP -3;
end;
end;
DisplayIt;
Until KeyPressed;
WhatKey;
Until upCase(KEY)='Q';
close (FNM);
end;
begin
ClrScr;
Init;
Entfile;
CloseGraph;
end.